home *** CD-ROM | disk | FTP | other *** search
/ Openstep 4.2 (Developer) / Openstep Developer 4.2.iso / NextDeveloper / Source / GNU / perl / Perl / ext / DB_File / DB_File.xs < prev    next >
Encoding:
Text File  |  1995-05-23  |  18.5 KB  |  938 lines
  1. /* 
  2.  
  3.  DB_File.xs -- Perl 5 interface to Berkeley DB 
  4.  
  5.  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
  6.  last modified 19th May 1995
  7.  version 0.2
  8.  
  9.  All comments/suggestions/problems are welcome
  10.  
  11.  Changes:
  12.     0.1 - Initial Release
  13.     0.2 - No longer bombs out if dbopen returns an error.
  14. */
  15.  
  16. #include "EXTERN.h"  
  17. #include "perl.h"
  18. #include "XSUB.h"
  19.  
  20. #include <db.h>
  21.  
  22. #include <fcntl.h> 
  23.  
  24. typedef DB * DB_File;
  25. typedef DBT DBTKEY ;
  26.  
  27. union INFO {
  28.         HASHINFO     hash ;
  29.         RECNOINFO     recno ;
  30.         BTREEINFO     btree ;
  31.       } ;
  32.  
  33. typedef struct {
  34.         SV *    sub ;
  35.     } CallBackInfo ;
  36.  
  37.  
  38. /* #define TRACE  */
  39.  
  40. #define db_DESTROY(db)                  (db->close)(db)
  41. #define db_DELETE(db, key, flags)       (db->del)(db, &key, flags)
  42. #define db_STORE(db, key, value, flags) (db->put)(db, &key, &value, flags)
  43. #define db_FETCH(db, key, flags)        (db->get)(db, &key, &value, flags)
  44.  
  45. #define db_close(db)            (db->close)(db)
  46. #define db_del(db, key, flags)          (db->del)(db, &key, flags)
  47. #define db_fd(db)                       (db->fd)(db) 
  48. #define db_put(db, key, value, flags)   (db->put)(db, &key, &value, flags)
  49. #define db_get(db, key, value, flags)   (db->get)(db, &key, &value, flags)
  50. #define db_seq(db, key, value, flags)   (db->seq)(db, &key, &value, flags)
  51. #define db_sync(db, flags)              (db->sync)(db, flags)
  52.  
  53.  
  54. #define OutputValue(arg, name)  \
  55.     { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
  56.  
  57. #define OutputKey(arg, name)                     \
  58.     { if (RETVAL == 0) \
  59.       {                             \
  60.         if (db->close != DB_recno_close)         \
  61.             sv_setpvn(arg, name.data, name.size);     \
  62.         else                         \
  63.             sv_setiv(arg, (I32)*(I32*)name.data - 1);     \
  64.       }                             \
  65.     }
  66.  
  67. /* Internal Global Data */
  68.  
  69. static recno_t Value ;
  70. static int (*DB_recno_close)() = NULL ;
  71.  
  72. static CallBackInfo hash_callback     = { 0 } ;
  73. static CallBackInfo compare_callback     = { 0 } ;
  74. static CallBackInfo prefix_callback     = { 0 } ;
  75.  
  76.  
  77. static int
  78. btree_compare(key1, key2)
  79. const DBT * key1 ;
  80. const DBT * key2 ;
  81. {
  82.     dSP ;
  83.     void * data1, * data2 ;
  84.     int retval ;
  85.     int count ;
  86.     
  87.     data1 = key1->data ;
  88.     data2 = key2->data ;
  89.  
  90.     /* As newSVpv will assume that the data pointer is a null terminated C 
  91.        string if the size parameter is 0, make sure that data points to an 
  92.        empty string if the length is 0
  93.     */
  94.     if (key1->size == 0)
  95.         data1 = "" ; 
  96.     if (key2->size == 0)
  97.         data2 = "" ;
  98.  
  99.     ENTER ;
  100.     SAVETMPS;
  101.  
  102.     PUSHMARK(sp) ;
  103.     EXTEND(sp,2) ;
  104.     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
  105.     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
  106.     PUTBACK ;
  107.  
  108.     count = perl_call_sv(compare_callback.sub, G_SCALAR); 
  109.  
  110.     SPAGAIN ;
  111.  
  112.     if (count != 1)
  113.         croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
  114.  
  115.     retval = POPi ;
  116.  
  117.     PUTBACK ;
  118.     FREETMPS ;
  119.     LEAVE ;
  120.     return (retval) ;
  121.  
  122. }
  123.  
  124. static DB_Prefix_t
  125. btree_prefix(key1, key2)
  126. const DBT * key1 ;
  127. const DBT * key2 ;
  128. {
  129.     dSP ;
  130.     void * data1, * data2 ;
  131.     int retval ;
  132.     int count ;
  133.     
  134.     data1 = key1->data ;
  135.     data2 = key2->data ;
  136.  
  137.     /* As newSVpv will assume that the data pointer is a null terminated C 
  138.        string if the size parameter is 0, make sure that data points to an 
  139.        empty string if the length is 0
  140.     */
  141.     if (key1->size == 0)
  142.         data1 = "" ;
  143.     if (key2->size == 0)
  144.         data2 = "" ;
  145.  
  146.     ENTER ;
  147.     SAVETMPS;
  148.  
  149.     PUSHMARK(sp) ;
  150.     EXTEND(sp,2) ;
  151.     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
  152.     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
  153.     PUTBACK ;
  154.  
  155.     count = perl_call_sv(prefix_callback.sub, G_SCALAR); 
  156.  
  157.     SPAGAIN ;
  158.  
  159.     if (count != 1)
  160.         croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
  161.  
  162.     retval = POPi ;
  163.  
  164.     PUTBACK ;
  165.     FREETMPS ;
  166.     LEAVE ;
  167.  
  168.     return (retval) ;
  169. }
  170.  
  171. static DB_Hash_t
  172. hash_cb(data, size)
  173. const void * data ;
  174. size_t size ;
  175. {
  176.     dSP ;
  177.     int retval ;
  178.     int count ;
  179.  
  180.     if (size == 0)
  181.         data = "" ;
  182.  
  183.     PUSHMARK(sp) ;
  184.     XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
  185.     PUTBACK ;
  186.  
  187.     count = perl_call_sv(hash_callback.sub, G_SCALAR); 
  188.  
  189.     SPAGAIN ;
  190.  
  191.     if (count != 1)
  192.         croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
  193.  
  194.     retval = POPi ;
  195.  
  196.     PUTBACK ;
  197.     FREETMPS ;
  198.     LEAVE ;
  199.  
  200.     return (retval) ;
  201. }
  202.  
  203.  
  204. #ifdef TRACE
  205.  
  206. static void
  207. PrintHash(hash)
  208. HASHINFO hash ;
  209. {
  210.     printf ("HASH Info\n") ;
  211.     printf ("  hash      = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
  212.     printf ("  bsize     = %d\n", hash.bsize) ;
  213.     printf ("  ffactor   = %d\n", hash.ffactor) ;
  214.     printf ("  nelem     = %d\n", hash.nelem) ;
  215.     printf ("  cachesize = %d\n", hash.cachesize) ;
  216.     printf ("  lorder    = %d\n", hash.lorder) ;
  217.  
  218. }
  219.  
  220. static void
  221. PrintRecno(recno)
  222. RECNOINFO recno ;
  223. {
  224.     printf ("RECNO Info\n") ;
  225.     printf ("  flags     = %d\n", recno.flags) ;
  226.     printf ("  cachesize = %d\n", recno.cachesize) ;
  227.     printf ("  psize     = %d\n", recno.psize) ;
  228.     printf ("  lorder    = %d\n", recno.lorder) ;
  229.     printf ("  reclen    = %d\n", recno.reclen) ;
  230.     printf ("  bval      = %d\n", recno.bval) ;
  231.     printf ("  bfname    = %s\n", recno.bfname) ;
  232. }
  233.  
  234. PrintBtree(btree)
  235. BTREEINFO btree ;
  236. {
  237.     printf ("BTREE Info\n") ;
  238.     printf ("  compare    = %s\n", (btree.compare ? "redefined" : "default")) ;
  239.     printf ("  prefix     = %s\n", (btree.prefix ? "redefined" : "default")) ;
  240.     printf ("  flags      = %d\n", btree.flags) ;
  241.     printf ("  cachesize  = %d\n", btree.cachesize) ;
  242.     printf ("  psize      = %d\n", btree.psize) ;
  243.     printf ("  maxkeypage = %d\n", btree.maxkeypage) ;
  244.     printf ("  minkeypage = %d\n", btree.minkeypage) ;
  245.     printf ("  lorder     = %d\n", btree.lorder) ;
  246. }
  247.  
  248. #else
  249.  
  250. #define PrintRecno(recno)
  251. #define PrintHash(hash)
  252. #define PrintBtree(btree)
  253.  
  254. #endif /* TRACE */
  255.  
  256.  
  257. static I32
  258. GetArrayLength(db)
  259. DB_File db ;
  260. {
  261.     DBT        key ;
  262.     DBT        value ;
  263.     int        RETVAL ;
  264.  
  265.     RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
  266.     if (RETVAL == 0)
  267.         RETVAL = *(I32 *)key.data ;
  268.     else if (RETVAL == 1) /* No key means empty file */
  269.         RETVAL = 0 ;
  270.  
  271.     return (RETVAL) ;
  272. }
  273.  
  274. static DB_File
  275. ParseOpenInfo(name, flags, mode, sv, string)
  276. char * name ;
  277. int    flags ;
  278. int    mode ;
  279. SV *   sv ;
  280. char * string ;
  281. {
  282.     SV **    svp;
  283.     HV *    action ;
  284.     union INFO    info ;
  285.     DB_File    RETVAL ;
  286.     void *    openinfo = NULL ;
  287.     DBTYPE    type = DB_HASH ;
  288.  
  289.  
  290.     if (sv)
  291.     {
  292.         if (! SvROK(sv) )
  293.             croak ("type parameter is not a reference") ;
  294.  
  295.         action = (HV*)SvRV(sv);
  296.         if (sv_isa(sv, "DB_File::HASHINFO"))
  297.         {
  298.             type = DB_HASH ;
  299.             openinfo = (void*)&info ;
  300.   
  301.             svp = hv_fetch(action, "hash", 4, FALSE); 
  302.  
  303.             if (svp && SvOK(*svp))
  304.             {
  305.                 info.hash.hash = hash_cb ;
  306.         hash_callback.sub = *svp ;
  307.             }
  308.             else
  309.             info.hash.hash = NULL ;
  310.  
  311.            svp = hv_fetch(action, "bsize", 5, FALSE);
  312.            info.hash.bsize = svp ? SvIV(*svp) : 0;
  313.            
  314.            svp = hv_fetch(action, "ffactor", 7, FALSE);
  315.            info.hash.ffactor = svp ? SvIV(*svp) : 0;
  316.          
  317.            svp = hv_fetch(action, "nelem", 5, FALSE);
  318.            info.hash.nelem = svp ? SvIV(*svp) : 0;
  319.          
  320.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  321.            info.hash.cachesize = svp ? SvIV(*svp) : 0;
  322.          
  323.            svp = hv_fetch(action, "lorder", 6, FALSE);
  324.            info.hash.lorder = svp ? SvIV(*svp) : 0;
  325.  
  326.            PrintHash(info) ; 
  327.         }
  328.         else if (sv_isa(sv, "DB_File::BTREEINFO"))
  329.         {
  330.             type = DB_BTREE ;
  331.             openinfo = (void*)&info ;
  332.    
  333.             svp = hv_fetch(action, "compare", 7, FALSE);
  334.             if (svp && SvOK(*svp))
  335.             {
  336.                 info.btree.compare = btree_compare ;
  337.                 compare_callback.sub = *svp ;
  338.             }
  339.             else
  340.                 info.btree.compare = NULL ;
  341.  
  342.             svp = hv_fetch(action, "prefix", 6, FALSE);
  343.             if (svp && SvOK(*svp))
  344.             {
  345.                 info.btree.prefix = btree_prefix ;
  346.                 prefix_callback.sub = *svp ;
  347.             }
  348.             else
  349.                 info.btree.prefix = NULL ;
  350.  
  351.             svp = hv_fetch(action, "flags", 5, FALSE);
  352.             info.btree.flags = svp ? SvIV(*svp) : 0;
  353.    
  354.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  355.             info.btree.cachesize = svp ? SvIV(*svp) : 0;
  356.          
  357.             svp = hv_fetch(action, "minkeypage", 10, FALSE);
  358.             info.btree.minkeypage = svp ? SvIV(*svp) : 0;
  359.         
  360.             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
  361.             info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
  362.  
  363.             svp = hv_fetch(action, "psize", 5, FALSE);
  364.             info.btree.psize = svp ? SvIV(*svp) : 0;
  365.          
  366.             svp = hv_fetch(action, "lorder", 6, FALSE);
  367.             info.btree.lorder = svp ? SvIV(*svp) : 0;
  368.  
  369.             PrintBtree(info) ;
  370.          
  371.         }
  372.         else if (sv_isa(sv, "DB_File::RECNOINFO"))
  373.         {
  374.             type = DB_RECNO ;
  375.             openinfo = (void *)&info ;
  376.  
  377.             svp = hv_fetch(action, "flags", 5, FALSE);
  378.             info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
  379.          
  380.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  381.             info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
  382.          
  383.             svp = hv_fetch(action, "psize", 5, FALSE);
  384.             info.recno.psize = (int) svp ? SvIV(*svp) : 0;
  385.          
  386.             svp = hv_fetch(action, "lorder", 6, FALSE);
  387.             info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
  388.          
  389.             svp = hv_fetch(action, "reclen", 6, FALSE);
  390.             info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
  391.          
  392.         svp = hv_fetch(action, "bval", 4, FALSE);
  393.             if (svp && SvOK(*svp))
  394.             {
  395.                 if (SvPOK(*svp))
  396.             info.recno.bval = (u_char)*SvPV(*svp, na) ;
  397.         else
  398.             info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
  399.             }
  400.             else
  401.          {
  402.         if (info.recno.flags & R_FIXEDLEN)
  403.                     info.recno.bval = (u_char) ' ' ;
  404.         else
  405.                     info.recno.bval = (u_char) '\n' ;
  406.         }
  407.          
  408.             svp = hv_fetch(action, "bfname", 6, FALSE); 
  409.             info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
  410.  
  411.             PrintRecno(info) ;
  412.         }
  413.         else
  414.             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
  415.     }
  416.  
  417.  
  418.     RETVAL = dbopen(name, flags, mode, type, openinfo) ; 
  419.  
  420.     /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
  421.                so remember a DB_RECNO by saving the address
  422.                of one of it's internal routines
  423.     */
  424.     if (RETVAL && type == DB_RECNO)
  425.         DB_recno_close = RETVAL->close ;
  426.  
  427.  
  428.     return (RETVAL) ;
  429. }
  430.  
  431.  
  432. static int
  433. not_here(s)
  434. char *s;
  435. {
  436.     croak("DB_File::%s not implemented on this architecture", s);
  437.     return -1;
  438. }
  439.  
  440. static double 
  441. constant(name, arg)
  442. char *name;
  443. int arg;
  444. {
  445.     errno = 0;
  446.     switch (*name) {
  447.     case 'A':
  448.     break;
  449.     case 'B':
  450.     if (strEQ(name, "BTREEMAGIC"))
  451. #ifdef BTREEMAGIC
  452.         return BTREEMAGIC;
  453. #else
  454.         goto not_there;
  455. #endif
  456.     if (strEQ(name, "BTREEVERSION"))
  457. #ifdef BTREEVERSION
  458.         return BTREEVERSION;
  459. #else
  460.         goto not_there;
  461. #endif
  462.     break;
  463.     case 'C':
  464.     break;
  465.     case 'D':
  466.     if (strEQ(name, "DB_LOCK"))
  467. #ifdef DB_LOCK
  468.         return DB_LOCK;
  469. #else
  470.         goto not_there;
  471. #endif
  472.     if (strEQ(name, "DB_SHMEM"))
  473. #ifdef DB_SHMEM
  474.         return DB_SHMEM;
  475. #else
  476.         goto not_there;
  477. #endif
  478.     if (strEQ(name, "DB_TXN"))
  479. #ifdef DB_TXN
  480.         return (U32)DB_TXN;
  481. #else
  482.         goto not_there;
  483. #endif
  484.     break;
  485.     case 'E':
  486.     break;
  487.     case 'F':
  488.     break;
  489.     case 'G':
  490.     break;
  491.     case 'H':
  492.     if (strEQ(name, "HASHMAGIC"))
  493. #ifdef HASHMAGIC
  494.         return HASHMAGIC;
  495. #else
  496.         goto not_there;
  497. #endif
  498.     if (strEQ(name, "HASHVERSION"))
  499. #ifdef HASHVERSION
  500.         return HASHVERSION;
  501. #else
  502.         goto not_there;
  503. #endif
  504.     break;
  505.     case 'I':
  506.     break;
  507.     case 'J':
  508.     break;
  509.     case 'K':
  510.     break;
  511.     case 'L':
  512.     break;
  513.     case 'M':
  514.     if (strEQ(name, "MAX_PAGE_NUMBER"))
  515. #ifdef MAX_PAGE_NUMBER
  516.         return (U32)MAX_PAGE_NUMBER;
  517. #else
  518.         goto not_there;
  519. #endif
  520.     if (strEQ(name, "MAX_PAGE_OFFSET"))
  521. #ifdef MAX_PAGE_OFFSET
  522.         return MAX_PAGE_OFFSET;
  523. #else
  524.         goto not_there;
  525. #endif
  526.     if (strEQ(name, "MAX_REC_NUMBER"))
  527. #ifdef MAX_REC_NUMBER
  528.         return (U32)MAX_REC_NUMBER;
  529. #else
  530.         goto not_there;
  531. #endif
  532.     break;
  533.     case 'N':
  534.     break;
  535.     case 'O':
  536.     break;
  537.     case 'P':
  538.     break;
  539.     case 'Q':
  540.     break;
  541.     case 'R':
  542.     if (strEQ(name, "RET_ERROR"))
  543. #ifdef RET_ERROR
  544.         return RET_ERROR;
  545. #else
  546.         goto not_there;
  547. #endif
  548.     if (strEQ(name, "RET_SPECIAL"))
  549. #ifdef RET_SPECIAL
  550.         return RET_SPECIAL;
  551. #else
  552.         goto not_there;
  553. #endif
  554.     if (strEQ(name, "RET_SUCCESS"))
  555. #ifdef RET_SUCCESS
  556.         return RET_SUCCESS;
  557. #else
  558.         goto not_there;
  559. #endif
  560.     if (strEQ(name, "R_CURSOR"))
  561. #ifdef R_CURSOR
  562.         return R_CURSOR;
  563. #else
  564.         goto not_there;
  565. #endif
  566.     if (strEQ(name, "R_DUP"))
  567. #ifdef R_DUP
  568.         return R_DUP;
  569. #else
  570.         goto not_there;
  571. #endif
  572.     if (strEQ(name, "R_FIRST"))
  573. #ifdef R_FIRST
  574.         return R_FIRST;
  575. #else
  576.         goto not_there;
  577. #endif
  578.     if (strEQ(name, "R_FIXEDLEN"))
  579. #ifdef R_FIXEDLEN
  580.         return R_FIXEDLEN;
  581. #else
  582.         goto not_there;
  583. #endif
  584.     if (strEQ(name, "R_IAFTER"))
  585. #ifdef R_IAFTER
  586.         return R_IAFTER;
  587. #else
  588.         goto not_there;
  589. #endif
  590.     if (strEQ(name, "R_IBEFORE"))
  591. #ifdef R_IBEFORE
  592.         return R_IBEFORE;
  593. #else
  594.         goto not_there;
  595. #endif
  596.     if (strEQ(name, "R_LAST"))
  597. #ifdef R_LAST
  598.         return R_LAST;
  599. #else
  600.         goto not_there;
  601. #endif
  602.     if (strEQ(name, "R_NEXT"))
  603. #ifdef R_NEXT
  604.         return R_NEXT;
  605. #else
  606.         goto not_there;
  607. #endif
  608.     if (strEQ(name, "R_NOKEY"))
  609. #ifdef R_NOKEY
  610.         return R_NOKEY;
  611. #else
  612.         goto not_there;
  613. #endif
  614.     if (strEQ(name, "R_NOOVERWRITE"))
  615. #ifdef R_NOOVERWRITE
  616.         return R_NOOVERWRITE;
  617. #else
  618.         goto not_there;
  619. #endif
  620.     if (strEQ(name, "R_PREV"))
  621. #ifdef R_PREV
  622.         return R_PREV;
  623. #else
  624.         goto not_there;
  625. #endif
  626.     if (strEQ(name, "R_RECNOSYNC"))
  627. #ifdef R_RECNOSYNC
  628.         return R_RECNOSYNC;
  629. #else
  630.         goto not_there;
  631. #endif
  632.     if (strEQ(name, "R_SETCURSOR"))
  633. #ifdef R_SETCURSOR
  634.         return R_SETCURSOR;
  635. #else
  636.         goto not_there;
  637. #endif
  638.     if (strEQ(name, "R_SNAPSHOT"))
  639. #ifdef R_SNAPSHOT
  640.         return R_SNAPSHOT;
  641. #else
  642.         goto not_there;
  643. #endif
  644.     break;
  645.     case 'S':
  646.     break;
  647.     case 'T':
  648.     break;
  649.     case 'U':
  650.     break;
  651.     case 'V':
  652.     break;
  653.     case 'W':
  654.     break;
  655.     case 'X':
  656.     break;
  657.     case 'Y':
  658.     break;
  659.     case 'Z':
  660.     break;
  661.     case '_':
  662.     if (strEQ(name, "__R_UNUSED"))
  663. #ifdef __R_UNUSED
  664.         return __R_UNUSED;
  665. #else
  666.         goto not_there;
  667. #endif
  668.     break;
  669.     }
  670.     errno = EINVAL;
  671.     return 0;
  672.  
  673. not_there:
  674.     errno = ENOENT;
  675.     return 0;
  676. }
  677.  
  678. MODULE = DB_File    PACKAGE = DB_File    PREFIX = db_
  679.  
  680. double
  681. constant(name,arg)
  682.     char *        name
  683.     int        arg
  684.  
  685.  
  686. DB_File
  687. db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
  688.     char *        dbtype
  689.     int        flags
  690.     int        mode
  691.     CODE:
  692.     {
  693.         char *    name = (char *) NULL ; 
  694.         SV *    sv = (SV *) NULL ; 
  695.  
  696.         if (items >= 2 && SvOK(ST(1))) 
  697.             name = (char*) SvPV(ST(1), na) ; 
  698.  
  699.             if (items == 5)
  700.             sv = ST(4) ;
  701.  
  702.         RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
  703.     }
  704.     OUTPUT:    
  705.         RETVAL
  706.  
  707. BOOT:
  708.     newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
  709.  
  710. int
  711. db_DESTROY(db)
  712.     DB_File        db
  713.  
  714.  
  715. int
  716. db_DELETE(db, key, flags=0)
  717.     DB_File        db
  718.     DBTKEY        key
  719.     u_int        flags
  720.  
  721. int
  722. db_FETCH(db, key, flags=0)
  723.     DB_File        db
  724.     DBTKEY        key
  725.     u_int        flags
  726.     CODE:
  727.     {
  728.         DBT        value  ;
  729.  
  730.         RETVAL = (db->get)(db, &key, &value, flags) ;
  731.         ST(0) = sv_newmortal();
  732.         if (RETVAL == 0)
  733.             sv_setpvn(ST(0), value.data, value.size);
  734.     }
  735.  
  736. int
  737. db_STORE(db, key, value, flags=0)
  738.     DB_File        db
  739.     DBTKEY        key
  740.     DBT        value
  741.     u_int        flags
  742.  
  743.  
  744. int
  745. db_FIRSTKEY(db)
  746.     DB_File        db
  747.     CODE:
  748.     {
  749.         DBTKEY        key ;
  750.         DBT        value ;
  751.  
  752.         RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;
  753.         ST(0) = sv_newmortal();
  754.         if (RETVAL == 0)
  755.         {
  756.             if (db->type != DB_RECNO)
  757.                 sv_setpvn(ST(0), key.data, key.size);
  758.             else
  759.                 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
  760.         }
  761.     }
  762.  
  763. int
  764. db_NEXTKEY(db, key)
  765.     DB_File        db
  766.     DBTKEY        key
  767.     CODE:
  768.     {
  769.         DBT        value ;
  770.  
  771.         RETVAL = (db->seq)(db, &key, &value, R_NEXT) ;
  772.         ST(0) = sv_newmortal();
  773.         if (RETVAL == 0)
  774.         {
  775.             if (db->type != DB_RECNO)
  776.                 sv_setpvn(ST(0), key.data, key.size);
  777.             else
  778.                 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
  779.         }
  780.     }
  781.  
  782. #
  783. # These would be nice for RECNO
  784. #
  785.  
  786. int
  787. unshift(db, ...)
  788.     DB_File        db
  789.     CODE:
  790.     {
  791.         DBTKEY    key ;
  792.         DBT        value ;
  793.         int        i ;
  794.         int        One ;
  795.  
  796.         RETVAL = -1 ;
  797.         for (i = items-1 ; i > 0 ; --i)
  798.         {
  799.             value.data = SvPV(ST(i), na) ;
  800.             value.size = na ;
  801.             One = 1 ;
  802.             key.data = &One ;
  803.             key.size = sizeof(int) ;
  804.             RETVAL = (db->put)(db, &key, &value, R_IBEFORE) ;
  805.             if (RETVAL != 0)
  806.                 break;
  807.         }
  808.     }
  809.     OUTPUT:
  810.         RETVAL
  811.  
  812. I32
  813. pop(db)
  814.     DB_File        db
  815.     CODE:
  816.     {
  817.         DBTKEY    key ;
  818.         DBT        value ;
  819.  
  820.         /* First get the final value */
  821.         RETVAL = (db->seq)(db, &key, &value, R_LAST) ;    
  822.         ST(0) = sv_newmortal();
  823.         /* Now delete it */
  824.         if (RETVAL == 0)
  825.         {
  826.             RETVAL = (db->del)(db, &key, R_CURSOR) ;
  827.             if (RETVAL == 0)
  828.                 sv_setpvn(ST(0), value.data, value.size);
  829.         }
  830.     }
  831.  
  832. I32
  833. shift(db)
  834.     DB_File        db
  835.     CODE:
  836.     {
  837.         DBTKEY    key ;
  838.         DBT        value ;
  839.  
  840.         /* get the first value */
  841.         RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;    
  842.         ST(0) = sv_newmortal();
  843.         /* Now delete it */
  844.         if (RETVAL == 0)
  845.         {
  846.             RETVAL = (db->del)(db, &key, R_CURSOR) ;
  847.             if (RETVAL == 0)
  848.                 sv_setpvn(ST(0), value.data, value.size);
  849.         }
  850.     }
  851.  
  852.  
  853. I32
  854. push(db, ...)
  855.     DB_File        db
  856.     CODE:
  857.     {
  858.         DBTKEY    key ;
  859.         DBT        value ;
  860.         int        i ;
  861.  
  862.         /* Set the Cursor to the Last element */
  863.         RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
  864.         if (RETVAL == 0)
  865.         {
  866.         /* for (i = 1 ; i < items ; ++i) */
  867.         for (i = items - 1 ; i > 0 ; --i)
  868.         {
  869.             value.data = SvPV(ST(i), na) ;
  870.             value.size = na ;
  871.             RETVAL = (db->put)(db, &key, &value, R_IAFTER) ;
  872.             if (RETVAL != 0)
  873.                 break;
  874.         }
  875.         }
  876.     }
  877.     OUTPUT:
  878.         RETVAL
  879.  
  880.  
  881. I32
  882. length(db)
  883.     DB_File        db
  884.     CODE:
  885.         RETVAL = GetArrayLength(db) ;
  886.     OUTPUT:
  887.         RETVAL
  888.  
  889.  
  890. #
  891. # Now provide an interface to the rest of the DB functionality
  892. #
  893.  
  894. int
  895. db_del(db, key, flags=0)
  896.     DB_File        db
  897.     DBTKEY        key
  898.     u_int        flags
  899.  
  900.  
  901. int
  902. db_get(db, key, value, flags=0)
  903.     DB_File        db
  904.     DBTKEY        key
  905.     DBT        value
  906.     u_int        flags
  907.     OUTPUT:
  908.       value
  909.  
  910. int
  911. db_put(db, key, value, flags=0)
  912.     DB_File        db
  913.     DBTKEY        key
  914.     DBT        value
  915.     u_int        flags
  916.     OUTPUT:
  917.       key        if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
  918.  
  919. int
  920. db_fd(db)
  921.     DB_File        db
  922.  
  923. int
  924. db_sync(db, flags=0)
  925.     DB_File        db
  926.     u_int        flags
  927.  
  928.  
  929. int
  930. db_seq(db, key, value, flags)
  931.     DB_File        db
  932.     DBTKEY        key 
  933.     DBT        value
  934.     u_int        flags
  935.     OUTPUT:
  936.       key
  937.       value
  938.